home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / fortra.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  6.7 KB  |  171 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module fortra)
  13.  
  14. (DECLARE-TOP (SPECIAL LB RB            ;Used for communication with MSTRING.
  15.           $LOADPRINT    ;If NIL, no load message gets printed.
  16.           1//2 -1//2)
  17.      (*LEXPR FORTRAN-PRINT $FORTMX))
  18.  
  19. (DEFMVAR $FORTSPACES NIL
  20.    "If T, Fortran card images are filled out to 80 columns using spaces."
  21.    BOOLEAN
  22.    MODIFIED-COMMANDS '$FORTRAN)
  23.  
  24. (DEFMVAR $FORTINDENT 0
  25.    "The number of spaces (beyond 6) to indent Fortran statements as they
  26.    are printed."
  27.    FIXNUM
  28.    MODIFIED-COMMANDS '$FORTRAN)
  29.  
  30. (DEFMVAR $FORTFLOAT NIL "Something JPG is working on.")
  31.  
  32. ;; This function is called from Macsyma toplevel.  If the argument is a
  33. ;; symbol, and the symbol is bound to a matrix, then the matrix is printed
  34. ;; using an array assignment notation.
  35.  
  36. (DEFMSPEC $FORTRAN (L)
  37.  (SETQ L (FEXPRCHECK L))
  38.  (LET ((VALUE (STRMEVAL L)))
  39.       (COND ((MSETQP L) (SETQ VALUE `((MEQUAL) ,(CADR L) ,(MEVAL L)))))
  40.       (COND ((AND (SYMBOLP L) ($MATRIXP VALUE))
  41.          ($FORTMX L VALUE))
  42.         ((AND (NOT (ATOM VALUE)) (EQ (CAAR VALUE) 'MEQUAL)
  43.           (SYMBOLP (CADR VALUE)) ($MATRIXP (CADDR VALUE)))
  44.          ($FORTMX (CADR VALUE) (CADDR VALUE)))
  45.         (T (FORTRAN-PRINT VALUE)))))
  46.  
  47. ;; This function is called from Lisp programs.  It takes an expression and
  48. ;; a stream argument.  Default stream is NIL in MacLisp and *STANDARD-OUTPUT*
  49. ;; in LMLisp.  This should be canonicalized in Macsyma at some point.
  50.  
  51. ;; TERPRI is a PDP10 MacLisp flag which, if set to T, will keep symbols and
  52. ;; bignums from being broken across page boundaries when printed.  $LOADPRINT
  53. ;; is NIL to keep a message from being printed when the file containing MSTRING
  54. ;; is loaded.  (MRG;GRIND)
  55.  
  56. (DEFPROP MEXPT (#\* #\*) DISSYM)
  57.  
  58. (DEFUN FORTRAN-PRINT (X &OPTIONAL (STREAM #+Maclisp NIL #-Maclisp *standard-output*)
  59.             &AUX #+PDP10 (TERPRI T) #+PDP10 ($LOADPRINT NIL)
  60.                 ;; This is a poor way of saying that array references
  61.                   ;; are to be printed with parens instead of brackets.
  62.             (LB #. left-parentheses-char ) (RB #. right-parentheses-char ))
  63.   ;; Restructure the expression for displaying.
  64.   (SETQ X (FORTSCAN X))
  65.   ;; Linearize the expression using MSTRING.  Some global state must be
  66.   ;; modified for MSTRING to generate using Fortran syntax.  This must be
  67.   ;; undone so as not to modifiy the toplevel behavior of MSTRING.
  68.   (UNWIND-PROTECT
  69.   
  70.     (DEFPROP MEXPT MSIZE-INFIX GRIND)
  71.     (DEFPROP MMINUS 100. LBP)
  72.      
  73.     (DEFPROP MSETQ (#\:) STRSYM)  
  74.     (SETQ X (mstring x))
  75.    ;; Make sure this gets done before exiting this frame.
  76.    (DEFPROP MEXPT MSZ-MEXPT GRIND)
  77.    (REMPROP 'MMINUS 'LBP)
  78.    )
  79.   
  80.   ;; MSTRING returns a list of characters.   Now print them.
  81.   (DO ((C #.(char-int #\0)
  82.       (f+ 1 (remainder (f- c #. (char-int #\0))
  83.         16) #. (char-int #\0)))
  84.        (COLUMN (f+ 6 $FORTINDENT) (f+ 9 $FORTINDENT)))
  85.       ((NULL X))
  86.       ;; Print five spaces, a continuation character if needed, and then
  87.       ;; more spaces.  COLUMN points to the last column printed in.  When
  88.       ;; it equals 80, we should quit.
  89.       (COND ((= C #. (char-int #\0))
  90.          (PRINT-SPACES COLUMN STREAM))
  91.         (T (PRINT-SPACES 5 STREAM)
  92.            (TYO (code-char C) STREAM)
  93.            (PRINT-SPACES (f- COLUMN 6) STREAM)))
  94.       ;; Print the expression.  Remember, Fortran ignores blanks and line
  95.       ;; terminators, so we don't care where the expression is broken.
  96.       (DO ()
  97.       ((= COLUMN 72.))
  98.       (IF (NULL X)
  99.           (IF $FORTSPACES (TYO #\SPACE STREAM) (RETURN NIL))
  100.           (progn (and (equal (car x) #. back-slash-char) (setq x (cdr x)))
  101.              (TYO (POP X) STREAM)))
  102.       (INCREMENT COLUMN))
  103.       ;; Columns 73 to 80 contain spaces
  104.       (IF $FORTSPACES (PRINT-SPACES 8 STREAM))
  105.       (TERPRI STREAM))
  106.   '$DONE)
  107.  
  108. (DEFUN PRINT-SPACES (N STREAM)
  109.        (DOTIMES (I N) (TYO #\SPACE STREAM)))
  110.  
  111. ;; This function is similar to NFORMAT.  Prepare an expression
  112. ;; for printing by converting x^(1/2) to sqrt(x), etc.  A better
  113. ;; way of doing this would be to have a programmable printer and
  114. ;; not cons any new expressions at all.  Some of this formatting, such
  115. ;; as E^X --> EXP(X) is specific to Fortran, but why isn't the standard
  116. ;; function used for the rest?
  117.  
  118. (DEFUN FORTSCAN (E)
  119.  (COND ((ATOM E) (cond ((eq e '$%i) '((mprogn) 0.0 1.0))
  120.                (t E))) ;%I is (0,1)
  121.        ((AND (EQ (CAAR E) 'MEXPT) (EQ (CADR E) '$%E))
  122.     (LIST '($EXP SIMP) (FORTSCAN (CADDR E))))
  123.        ((AND (EQ (CAAR E) 'MEXPT) (ALIKE1 (CADDR E) 1//2))
  124.     (LIST '(%SQRT SIMP) (FORTSCAN (CADR E))))
  125.        ((AND (EQ (CAAR E) 'MEXPT) (ALIKE1 (CADDR E) -1//2))
  126.     (LIST '(MQUOTIENT SIMP) 1 (LIST '(%SQRT SIMP) (FORTSCAN (CADR E)))))
  127.        ((AND (EQ (CAAR E) 'MTIMES) (RATNUMP (CADR E))
  128.          (zl-MEMBER (CADADR E) '(1 -1)))
  129.     (COND ((EQUAL (CADADR E) 1) (FORTSCAN-MTIMES E))
  130.           (T (LIST '(MMINUS SIMP) (FORTSCAN-MTIMES E)))))
  131.        ((EQ (CAAR E) 'RAT)
  132.     (LIST '(MQUOTIENT SIMP) (FLOAT (CADR E)) (FLOAT (CADDR E))))
  133.        ((EQ (CAAR E) 'MRAT) (FORTSCAN (RATDISREP E)))
  134.        ;;  complex numbers to f77 syntax a+b%i ==> (a,b)
  135.        ((and (memq (caar e) '(mtimes mplus))
  136.          ((lambda (a) 
  137.               (and (numberp (cadr a))
  138.                (numberp (caddr a))
  139.                (not (zerop1 (cadr a)))
  140.                (list '(mprogn) (caddr a) (cadr a))))
  141.           (simplify ($bothcoef e '$%i)))))
  142.        (T (CONS (CAR E) (MAPCAR 'FORTSCAN (CDR E))))))
  143.  
  144. (DEFUN FORTSCAN-MTIMES (E)
  145.        (LIST '(MQUOTIENT SIMP)
  146.          (COND ((NULL (CDDDR E)) (FORTSCAN (CADDR E)))
  147.            (T (CONS (CAR E) (MAPCAR 'FORTSCAN (CDDR E)))))
  148.          (FLOAT (CADDR (CADR E)))))
  149.  
  150. ;; Takes a name and a matrix and prints a sequence of Fortran assignment
  151. ;; statements of the form
  152. ;;  NAME(I,J) = <corresponding matrix element>
  153.  
  154. (DEFMFUN $FORTMX (NAME MAT &OPTIONAL (STREAM #-CL NIL #+CL *standard-output*)
  155.              &AUX ($LOADPRINT NIL))
  156.   (COND ((NOT (symbolp NAME))
  157.      (MERROR "~%First argument to FORTMX must be a symbol."))
  158.     ((NOT ($MATRIXP MAT))
  159.      (MERROR "Second argument to FORTMX not a matrix: ~M" MAT)))
  160.   (DO ((MAT (CDR MAT) (CDR MAT)) (I 1 (f1+ I))) ((NULL MAT))
  161.       (DECLARE (FIXNUM I))
  162.       (DO ((M (CDAR MAT) (CDR M)) (J 1 (f1+ J))) ((NULL M))
  163.       (DECLARE (FIXNUM J))
  164.       (FORTRAN-PRINT `((MEQUAL) ((,NAME) ,I ,J) ,(CAR M)) STREAM)))
  165.   '$DONE)
  166.  
  167.  
  168. ;; Local Modes:
  169. ;; Comment Column:26
  170. ;; End:
  171.